#[S]hiplist [A]utomation [P]roject (SAP)
#DATE: January 7-14, 2008
#Author: Coltin Caverhill
#Currently Maintained by: ...

sub trim($) #Removes whitespace at the beginning and end of a string.
{
	my $tString = @_[0];
	$tString =~ s/^\s+//;
	$tString =~ s/\s+$//;
	return $tString;
}

sub extract { #Removes the directory path from a file (C:/bbbb/c/dd/mme.conf => mme.conf)
	sub remSect { #Removes one section at a time, made for (a|b|c)/, [An OR clause]
		return substr(@_[0],index(@_[0],"/")+1,length(@_[0]));
	}
	my $cur=@_[0];
	while (index($cur,'/') != -1) {
		$cur=remSect($cur);
	}
	return $cur;
}

sub relPath { #Returns the relative path of a filepath from its cScript
	my $curPath = @_[0];
	my $csc = @_[1];
	if ($csc eq 'all/') { #Handles special all/ class
		return $curPath;
	} else {
		while ($csc) { #Removes sections in Lock-Step
			$curPath=remSect($curPath);
			$csc=remSect($csc);
		}
		return $curPath;
	}
}

sub unique { #Returns all the unique values of an array
	#@newShiplist = unique(\@newShiplist);
	sub inLst {	#Returns if a string is in an array
		my $blank=$_[0];
		my @array=@$blank;
		my $elm=$_[1];
		my $tTag = $_[2];
		for (@array) {
			if (relPath(trim($_), $tTag) eq relPath(trim($elm), $tTag)) {
				#print $elm,$_,"\n";
				return 1;
			}
		}
		return 0;
	}
	my $tMp = $_[0];
	my $tTag =$_[1];
	my @nList=();
	for (@$tMp) {
		if (inLst(\@nList, $_, $tTag) == 0) {
			push (@nList, $_);
		}
	}
	@nList;
}

sub generateSearch { #This is a cScript parser for the configuration file
	my $cScript=trim(@_[0]); #This used to be complex, but it was really an overcomplication
	if ($cScript eq 'all') {
		return '.*';
	} else {
		return '^'.$cScript;
	}
}

sub generateSGML_list {#Searches through an .sgm file and generates a list of binaries
	my $fINF=@_[0]; #INF, File retrieving input from
	my $fOUF=@_[1]; #OUF, Backup file, ie Output file (SGML)
	my $tKey=@_[2]; #$key, Current psuedo comment key
	my $found = 0;
	while (<$fINF>) { #Searches for the tag, and then the list
		my $tmp = $_;
		print $fOUF $_;
		chomp $tmp;
		if (!$found) {
			if ($tmp eq "<!--$tKey-->") {
				$found=1;
			}
		} else {last unless $tmp ne "<ul>"}
	}
										#At this point, we've located the commented keyward and the <ul>.
										#The next line of input will be from a <li> tag, containing the first
										#element of the list after its extracted.
	
	#All lines begining with liExt are extracted and stored as a hash
	my $liExt = "<li><fname>"; #Was originally intended for different sgm formats
	my %sList; #The 'master' list of binaries => sgml
	my $lastKey;
	my $extra="";
	while (<$fINF>) {
		my $tmp = $_;
		$tmp = trim ($tmp);
		last unless $tmp ne '</ul>'; #Exits when we find </ul>, the end of the list
		if (substr($tmp,0,length('<!--')) eq '<!--') {
			print $fOUF $_;
			while (1) {
				my $nTMP = <$fINF>;
				my $nTMP2 = substr($nTMP,0,length('-->'));
				last unless $nTMP2 ne '-->';
				print $fOUF $nTMP;
			}
			print $fOUF "-->\n";
		} elsif (substr($tmp,0,length($liExt)) eq $liExt) { #Determines if the current SGML line is equal to a line we are looking for, an liExt.
			my $nTemp = substr($tmp,length($liExt),90);
			$nTemp = substr($nTemp, 0, index($nTemp, '</fname>')); 	#Cuts out everything we don't need;
			$sList{$nTemp}=($_); 								#Stores the SGML for later in case we need it.
			$sList{$lastKey}=$sList{$lastKey}.$extra; 	#Adds anything to the last extra incase there has been any new code in between, like </li>
			$extra=""; 												#Clears the extra, ie refreshing the cache
			$lastKey=$nTemp;										#Sets the lastKey to the one we just used, so we can add the extra later
		} else {
			$extra = $extra.$_;
		}
	}
	delete $sList{''};
	return %sList; #Returns the extracted file/SGML hash
}

sub generateShiplist {
	my $tdepShiplist = @_[0];
	my $cSI = @_[1];
	if ($cSI eq ('.*')|$cSI eq ('^all/')) { #The special form, root/{rest}/
		return @$tdepShiplist;
	} else {
		my @tmp=grep(/$cSI/,@$tdepShiplist);
		@$tdepShiplist = grep(!/$cSI/,@$tdepShiplist);	#Depreciate the depreciated list some more for one of the special forms
		print "\n\nERROR[0x006]: List not generated from shiplist for $cSI, possible problem. See documentation, many possible reasons. Possible incorrect config file.\n\n" unless @tmp;
		return @tmp;												#Using the parsed cScript, selects all shiplist entires that apply
	}
}

sub inArray {
	my $elm = 	extract(trim(@_[0]));
	my $arRef = @_[1];
	for (@$arRef) {
		return 1 if ($elm eq extract(trim($_)));
	}
	return 0;
}

sub remArray {
	my $elm = 	trim(extract(@_[0]));
	my $arRef = @_[1];
	
	my $i = -1;
	while ($$arRef[$i++]) {
		if ($elm eq trim(extract($$arRef[$i]))) {
			splice (@$arRef, $i, 1);
			return 1;
		}
	}
	return 0;
}

sub listToEng {
	my $listRef = @_[0];
	
	return '' unless (@$listRef);
	return $$listRef[0] if (scalar(@$listRef) == 1);
	
	my $eng = $$listRef[0];
	my $i = 2;
	while ($$listRef[$i++]) {
		$eng = $eng.", ".$$listRef[$i-2];
		#print $i," -> ",$$listRef[$i-2],"\n";
	}
	return $eng.", and ".$$listRef[scalar(@$listRef)-1];
}

sub reportMissingEntries { #Takes an or clause, target/qnx6/(armle|x86)/ and determines if binaries to all of them exist, reports as necessary
	my $reportRef = @_[0];
	my $cScript = @_[1];
	my $shiplistRef = @_[2];
	my $root = substr($cScript, 0, index ($cScript, "/(")+1);
	my $end = substr($cScript, index($cScript, ")/")+2, length($cScript));
	my $middle = substr($cScript, length ($root)+1, length($cScript)-length($root)-length($end)-3)."|";

	my @tagLooks;
	while ($middle) {
		push (@tagLooks, $root.substr ($middle, 0, index($middle, "|"))."/".$end);
		$middle = substr ($middle, index ($middle,"|")+1,length($middle));
	}

	my @aLists = (); #The list of list references
	my %listNames = {};
	for (@tagLooks) {
		my $t = $_;
		my @tlist = grep (/$t/,@$shiplistRef);
		push (@aLists, \@tlist); #Pushes the current list reference onto the list of list referenes.
		$listNames{\@tlist} = extract(substr($_, 0,length($_)-1));
	}
	
	for (@aLists) {
		my $curRef = $_;
		while (@$curRef) { 					#Go through its elements
			my $curTarg = pop(@$curRef);	#Pop out the elements

			my @Under = ($listNames{$curRef});
			my @notUnder = ();
			for (@aLists) {					# Cycle through others to see if they exist
				my $curRef2 = $_;
				if ($curRef2 ne $curRef) { #If the current reference doesn't equal the root reference
					if (inArray($curTarg, $curRef2)) { #If the element is in the array
						remArray ($curTarg, $curRef2),"\n";
						push (@Under, $listNames{$curRef2});
					} else {
						push (@notUnder, $listNames{$curRef2});
					}
				}
			}
			if (scalar(@aLists)>scalar(@Under)) {
				#print '"',extract(trim($curTarg)),'" was not found under ',listToEng(\@Under),", but it was found under ",listToEng(\@notUnder),"\n";
				push (@$reportRef, extract(trim($curTarg)).' was not found under '.listToEng(\@notUnder).", but it was found under ".listToEng(\@Under));
			}
		}
	}	
}

my $backTimeStamp = trim(`date`);
$backTimeStamp =~ s/:/-/g;

#Here the all the 'copying' is done. The real program starts shortly.
open CONF, '< shiplister.config' or die "\n\nError[0x000]: Cannot find config file\n\n";
my $url=trim(<CONF>);
my $infName="backup.html";
my $oufName=<CONF>;
my @report=();

open COPY, "< $url" or die "\n\nError[0x003]: Could not find $url\n\n";   			#Whats being copied
open NEWC, "> $infName" or die "\n\nError[0x004]: Could not create $infName\n\n";	#Where its going
print NEWC <COPY>;	#Do the copying
close COPY;
close NEWC;

open COPY, "< $url" or die $!;
open NEWC, "> $url.".$backTimeStamp.".bk" or die $!;
print NEWC <COPY>;	#Do the copying
close COPY;
close NEWC;

while (1) { #Infinite loop, well thats creative
	my $tShipPath=<CONF>;
	last if ($tShipPath eq 'done'); #Exits when the input is done. Literally.
	my @shiplist=();		#Resets shiplist
	my @depShiplist=();	#Resets depreciated shiplist

	my @tempShipPaths = split(/ /, $tShipPath); #Splits up the entry. This will be a list of tar files split by spaces
	for (@tempShipPaths) {	#Processes the tar files, loads them into one list
		my $truePath = 'patches/'.substr($_,6,11).'/shiplist';
		open TEMP, $_ or die "\n\nError[0x001]: File $tShipPath does not exist\n\n";
		close TEMP;
		`tar xf $_ $truePath`;

		open SHIP, $truePath or die "\n\nError[0x002]: Shiplist not created, unknown reason\n\n";
		my @tmpAlpha = <SHIP>;
		push (@shiplist, @tmpAlpha);
		close SHIP;
	}

	@depShiplist=@shiplist;
	while (<CONF>) { #Reads through tags
		last unless (trim($_) ne 'end'); #exits when the tags end, literally...k I'll stop with the bad humour

		open INF, "< $infName" or die $!;
		open OUF, "> $oufName" or die $!;
		my $mu=trim($_); #mu stands for something, not sure what anymore..
		my $key = substr($mu,1,index($mu,"]")-1),"\n"; 			#Extracts the key
		my $cTag = substr($mu,index($mu,"=>")+3,length($mu));	#Extracts the cScript
		my $cScriptIndex = generateSearch($cTag);					#Generates a regular expression from cScript
		my %origSGML=generateSGML_list(INF, OUF, $key);			#Generates list of binaries from the .sgm file
		my @newShiplist=generateShiplist(\@depShiplist, $cScriptIndex);	#Loads list of binaries from shiplist(s)
		#print "$cScriptIndex: ", index($cTag,'|'),"\n";
		reportMissingEntries (\@report, $cScriptIndex, \@newShiplist) if (index($cScriptIndex, "|") > -1);
		#print $cScriptIndex," ",$cTag,"\n";
		@newShiplist = unique(\@newShiplist, $cTag);				#Eliminates duplicates (.../x86/mme.conf, .../shle/mme.conf, etc)
		my %newMastList=();

		foreach $Curnt (sort(@newShiplist)) { #Rebuilds the SGML for new entires
			my $curRoot = relPath(trim($Curnt),$cTag);
			#print "NEW: ",trim($curRoot), "\n", trim($Curnt),"\n", trim($cTag),"\n\n";
			if ($origSGML{$curRoot}) {
				$newMastList{$curRoot}=$origSGML{$curRoot};
				delete $origSGML{$curRoot};
			} else {
				$newMastList{$curRoot}="\t<li><fname>$curRoot</fname>\n";
				push (@report, "Added $curRoot to $cTag");
			}
		}

		for (sort(keys %origSGML)) { #Adds everything that wasn't added to the report
			push (@report, "Removed $_ from $cTag");
			print OUF "<!-- removed : ",`date \t`,"\t<li><fname>",trim($_),"</fname>\n-->\n";
		}

		for (sort(keys %newMastList)) { #Rebuilds the sgml file
			print OUF $newMastList{$_};
		}
		
		print OUF "</ul>\n";
		print OUF <INF>; #Copy the remainder of the file
		close OUF;
		close INF;

		open COPY, "< $oufName";
		open NEWC, "> $infName";
		print NEWC <COPY>;
		close COPY;
		close NEWC;
	}
}
close CONF;

print "\n------------------------------------------------\n";
print "Final Report:\n";
if (@report) {
	$change=0;
	open SHPLSTR, "> $url.txt";
	for (sort (@report)) {
		print ++$change,'. ',$_,"\n";
		print SHPLSTR $change,'. ',$_,"\n";
	}
	close SHIPLSTR;
} else {
	print "No changes\n";
}

unlink "backup-$backTimeStamp.html";